perm filename COSDIT.CH[UHF,DEK] blob
sn#841753 filedate 1987-06-18 generic text, type T, neo UTF8
% Change file for DDTONE.WEB, changes to yield the ordered dither method
% changes for DDTONE.WEB to enhance contrasts
% Change file for DDTONE.WEB, computes a "sphere"
@x
reset(bytes_in,input_name,'/B:8')
@y
@z
@x
@!new_row:array[0..nn+1] of real; {densities in row being input}
@y
@!new_row:array[0..nn+1] of real; {densities in row being input}
@!row_buf:array[0..2,0..nn+1] of real; {`actual' data before enhancement}
@z
@x
@!t:eight_bits; {byte of input}
begin new_row[0]←0.0;
if i>mm then for j←1 to nn do new_row[j]←0.0
else for j←1 to nn do
begin read(bytes_in,t); new_row[j]←(255.5-t)/256.0;
end;
@y
@!x,@!y,@!z:real; {coordinates of input}
begin if i=1 then
begin for j←1 to nn do row_buf[2,j]←(1250+j*j)/1000000;
row_buf[2,0]←row_buf[2,1]; row_buf[2,nn+1]←row_buf[2,nn];
for j←0 to nn+1 do row_buf[1,j]←row_buf[2,j];
end;
for j←0 to nn+1 do
begin row_buf[0,j]←row_buf[1,j]; row_buf[1,j]←row_buf[2,j];
end;
if i<mm then
begin for j←1 to nn do
begin x←(i-119)/111.5; y←(j-120)/111.5; z←1.0-x*x-y*y;
if z<0.0 then row_buf[2,j]←(1250*(i+1)+j*j)/1000000
else row_buf[2,j]←(9+x-4*y-8*sqrt(z))/18.0;
end;
row_buf[2,0]←row_buf[2,1]; row_buf[2,nn+1]←row_buf[2,nn];
end;
new_row[0]←0.0;
for j←1 to nn do new_row[j]←9*row_buf[1,j]-row_buf[0,j-1]-row_buf[0,j]
-row_buf[0,j+1]-row_buf[1,j-1]-row_buf[1,j+1]-row_buf[2,j-1]
-row_buf[2,j]-row_buf[2,j+1];
@z
@x
begin i←class_row[k]; j←class_col[k];
while j≤nn do
begin @<Decide the color of pixel |[i,j]| and the resulting |err|@>;
for l←start[k] to start[k+1]-1 do
begin u←i+del_i[l]; v←j+del_j[l];
buffer[u,v]←buffer[u,v]+err*alpha[l];
end;
@y
begin i←class_row[k]-3; j←class_col[k];
while j≤nn do
begin @<Decide the color of pixel |[i,j]| and the resulting |err|@>;
@z
@x
err←buffer[i,j]; err_black←err-1.0;
if err_black+err>0 then
begin err←err_black; darkness[i,j]←black;
end
@y
if buffer[i,j]≥(k+0.5)/64.0 then darkness[i,j]←black
@z
@x
begin store(i,j); store(i-4,j+4); store(5-j,i); store(1-j,i-4);@/
store(4+j,1-i); store(j,5-i); store(5-i,5-j); store(1-i,1-j);
end;
@ @<Initialize the class number matrix@>=
k←0; store_eight(7,2); store_eight(8,3); store_eight(8,2); store_eight(8,1);@/
store_eight(1,4); store_eight(1,3); store_eight(1,2); store_eight(2,3);@/
@y
begin store(i,j); store(i+4,j+4); store(i,j+4); store(i+4,j);@/
store(i+2,j+2); store(i+6,j+6); store(i+2,j+6); store(i+6,j+2);
end;
procedure stero_eight(@!i,@!j:integer); {dual of the other}
begin store(i,j); store(i+4,j+4); store(i,j+4); store(i+4,j);@/
store(i+2,j+6); store(i+6,j+2); store(i+2,j+2); store(i+6,j+6);
end;
@ @<Initialize the class number matrix@>=
k←0; store_eight(1,1); stero_eight(1,3); store_eight(2,2); stero_eight(2,4);@/
store_eight(1,2); stero_eight(1,4); store_eight(2,1); stero_eight(2,3);@/
@z
@x
if hold[i,j] then class_row[k]←i-8;
@y
@z